封校与封班？——基于社会网络可视化的政策启示

背景及介绍

在全世界疫情背景下，学生的校园生活危机四伏。校园内老师、学生之间的传播会进一步传播到学生、教室所在社区，可见校园是疾病传播非常重要的一个途径。

疫情期间，全世界各地的政府为了防止疫情进一步传播而采取的封校措施屡见不鲜，虽然这种政策能够有效的阻碍疾病的进一步传播，然而，封校所带来的的社会、经济成本有时候是非常昂贵的。比如有些家长可能需要回家照顾孩子而需要放弃自己的工作，而对于父母是医护人员的家庭来说，这种成本不仅对家庭会有影响，对整个社会的公共卫生水平也会有消极的影响。

那么有没有即能有效防止疾病传播，又能将上面所说的成本最小化的方法呢？

2014年法国的一项实验表明（Barrat and Cattuto, 2014），通过先进的接触探测仪，封班而非直接封校的政策成为可行的一种方法，而这种方法既能够有效的阻碍疾病的进一步传播，也能避免封校所带来的社会、经济成本。

原研究虽然收集了网络数据，然而并没有对网络进行可视化展现，故本文将首先对研究所收集的网络数据进行可视化探索，最终对原文SEIR模型的结果进行讨论，最终得出结论。

数据来源：Socio-Pattern Website

(http://www.sociopatterns.org/datasets/primary-school-cumulative-networks/)

研究文章：Mitigation of infectious disease at school: targeted class closure vs school closure （Valerio Gemmetto, Alain Barrat, and Ciro Cattuto, BMC Infectious Diseases,2014）

(https://bmcinfectdis.biomedcentral.com/articles/10.1186/s12879-014-0695-9#additional-information)

社会网络探索

研究设计与数据来源

实验在法国里昂的一所小学进行，学校有来自五个年级十个班（每年级两个班）232名学生以及10名教师组成，总共242人。

研究中的数据是通过可穿戴测距仪收集的网络结构数据，仪器会记录有面对面接触的两人，以及接触时间超过二十秒的个体；数据的收集持续了两天。

准备工作与数据清理

# 清除工作环境
cat("\014");rm(list=ls())
# 加载相应的包
library(igraph)
library(dplyr)
library(ggplot2)
library(RColorBrewer)
# 读入数据
D <- read.csv('primaryschool.csv')
D_meta <- read.csv('metadata_primaryschool.csv')
head(D)
##   Source Target
## 1   1558   1567
## 2   1560   1570
## 3   1567   1574
## 4   1632   1818
## 5   1632   1866
## 6   1673   1698
head(D_meta)
##     ID Class Gender
## 1 1426    5B      M
## 2 1427    5B      F
## 3 1428    5B      M
## 4 1429    5B      F
## 5 1430    5B      M
## 6 1431    5B      F

（数据说明：本报告中有两个原始数据集。primaryschool.csv文件为节点列表，即记录了两个人之间的接触；第二个数据集metadata_primaryschool.csv为每个节点的属性，包括性别与所属班级。）

# 数据集管理
B <- as.data.frame(table(D)) # 添加边的权重变量（edge weight）为Freq
B1 <- subset(B,Freq>0) # 删除权重为0的边（无接触）
# 建立igraph图
Stucont <- graph_from_data_frame(B1, 
                                 directed = FALSE,  # 无向网络
                                 vertices = D_meta)

E(Stucont)$weight <- E(Stucont)$Freq # 为所有边赋予边属性（权重）

数据探索

Stucont # igraph数据集总览
## IGRAPH 3b5b419 UNW- 242 8317 -- 
## + attr: name (v/c), Class (v/c), Gender (v/c), Freq (e/n), weight (e/n)
## + edges from 3b5b419 (vertex names):
##  [1] 1426--1427 1426--1428 1427--1428 1426--1429 1427--1429 1428--1429
##  [7] 1426--1430 1427--1430 1428--1430 1429--1430 1426--1431 1427--1431
## [13] 1428--1431 1429--1431 1430--1431 1426--1434 1427--1434 1428--1434
## [19] 1429--1434 1430--1434 1431--1434 1426--1435 1427--1435 1428--1435
## [25] 1429--1435 1430--1435 1431--1435 1434--1435 1426--1437 1427--1437
## [31] 1428--1437 1429--1437 1430--1437 1431--1437 1434--1437 1435--1437
## [37] 1426--1439 1427--1439 1428--1439 1429--1439 1430--1439 1431--1439
## [43] 1434--1439 1435--1439 1437--1439 1426--1441 1427--1441 1428--1441
## + ... omitted several edges

通过上述网络结构数据的总览中能够看出，此网络为无向有权网络（UNW - Undirected Weighted Network），网络包含242个节点与8317条边；节点属性有三个，分别为师生ID、班级、性别；边属性有频率与权重。

gsize(Stucont) # 边数量
## [1] 8317
gorder(Stucont) # 节点数量
## [1] 242
V(Stucont) # 节点总览
## + 242/242 vertices, named, from 3b5b419:
##   [1] 1426 1427 1428 1429 1430 1431 1434 1435 1437 1439 1441 1443 1451 1452 1453
##  [16] 1457 1458 1459 1461 1465 1468 1471 1475 1477 1479 1480 1482 1483 1486 1489
##  [31] 1493 1495 1498 1500 1501 1502 1503 1504 1511 1516 1519 1520 1521 1522 1524
##  [46] 1525 1528 1532 1533 1538 1539 1545 1546 1548 1549 1551 1552 1555 1558 1560
##  [61] 1562 1563 1564 1567 1570 1572 1574 1578 1579 1580 1585 1592 1594 1601 1603
##  [76] 1604 1606 1609 1613 1616 1617 1618 1625 1628 1630 1632 1637 1641 1643 1647
##  [91] 1648 1649 1650 1653 1656 1661 1663 1664 1665 1666 1668 1670 1673 1674 1675
## [106] 1680 1681 1682 1684 1685 1687 1688 1695 1696 1697 1698 1700 1702 1704 1705
## [121] 1706 1707 1708 1709 1710 1711 1712 1713 1714 1715 1718 1719 1720 1722 1723
## [136] 1727 1730 1731 1732 1735 1737 1738 1739 1741 1743 1744 1745 1746 1748 1749
## + ... omitted several vertices
E(Stucont) # 边总览
## + 8317/8317 edges from 3b5b419 (vertex names):
##  [1] 1426--1427 1426--1428 1427--1428 1426--1429 1427--1429 1428--1429
##  [7] 1426--1430 1427--1430 1428--1430 1429--1430 1426--1431 1427--1431
## [13] 1428--1431 1429--1431 1430--1431 1426--1434 1427--1434 1428--1434
## [19] 1429--1434 1430--1434 1431--1434 1426--1435 1427--1435 1428--1435
## [25] 1429--1435 1430--1435 1431--1435 1434--1435 1426--1437 1427--1437
## [31] 1428--1437 1429--1437 1430--1437 1431--1437 1434--1437 1435--1437
## [37] 1426--1439 1427--1439 1428--1439 1429--1439 1430--1439 1431--1439
## [43] 1434--1439 1435--1439 1437--1439 1426--1441 1427--1441 1428--1441
## [49] 1429--1441 1431--1441 1434--1441 1435--1441 1437--1441 1439--1441
## [55] 1426--1443 1427--1443 1428--1443 1429--1443 1430--1443 1431--1443
## + ... omitted several edges
# 检查
V(Stucont)$Gender
##   [1] "M"       "F"       "M"       "F"       "M"       "F"       "F"      
##   [8] "M"       "F"       "M"       "M"       "F"       "F"       "M"      
##  [15] "F"       "F"       "M"       "M"       "F"       "F"       "M"      
##  [22] "M"       "F"       "M"       "M"       "F"       "M"       "F"      
##  [29] "M"       "F"       "F"       "M"       "M"       "M"       "F"      
##  [36] "F"       "F"       "F"       "M"       "M"       "F"       "F"      
##  [43] "Unknown" "M"       "F"       "M"       "M"       "M"       "M"      
##  [50] "F"       "F"       "M"       "F"       "M"       "M"       "M"      
##  [57] "F"       "F"       "M"       "F"       "F"       "F"       "M"      
##  [64] "M"       "F"       "F"       "F"       "M"       "M"       "M"      
##  [71] "M"       "M"       "M"       "F"       "F"       "F"       "F"      
##  [78] "F"       "M"       "F"       "F"       "Unknown" "M"       "M"      
##  [85] "M"       "F"       "Unknown" "F"       "F"       "M"       "F"      
##  [92] "M"       "Unknown" "Unknown" "M"       "F"       "F"       "M"      
##  [99] "M"       "M"       "Unknown" "F"       "M"       "F"       "F"      
## [106] "F"       "M"       "F"       "F"       "F"       "F"       "M"      
## [113] "F"       "F"       "M"       "M"       "F"       "F"       "M"      
## [120] "M"       "F"       "M"       "M"       "Unknown" "M"       "F"      
## [127] "F"       "F"       "M"       "F"       "F"       "F"       "F"      
## [134] "F"       "M"       "F"       "Unknown" "M"       "M"       "M"      
## [141] "M"       "F"       "M"       "M"       "F"       "M"       "Unknown"
## [148] "Unknown" "M"       "F"       "M"       "F"       "M"       "Unknown"
## [155] "F"       "M"       "F"       "M"       "M"       "M"       "F"      
## [162] "M"       "M"       "F"       "F"       "F"       "F"       "Unknown"
## [169] "F"       "M"       "M"       "M"       "M"       "F"       "M"      
## [176] "F"       "M"       "F"       "F"       "M"       "M"       "Unknown"
## [183] "F"       "F"       "M"       "M"       "M"       "F"       "F"      
## [190] "F"       "M"       "F"       "M"       "F"       "M"       "Unknown"
## [197] "F"       "M"       "F"       "M"       "M"       "M"       "M"      
## [204] "M"       "M"       "Unknown" "F"       "M"       "F"       "F"      
## [211] "F"       "F"       "M"       "M"       "M"       "F"       "F"      
## [218] "M"       "M"       "M"       "M"       "M"       "F"       "M"      
## [225] "M"       "F"       "F"       "F"       "M"       "F"       "F"      
## [232] "M"       "M"       "F"       "M"       "M"       "F"       "M"      
## [239] "F"       "M"       "F"       "F"
V(Stucont)$Gender[V(Stucont)$Gender=='Unknown'] <- NA # 将性别属性缺失值赋值NA
V(Stucont)$Class
##   [1] "5B"       "5B"       "5B"       "5B"       "5B"       "5B"      
##   [7] "5B"       "5B"       "5B"       "5B"       "5B"       "5B"      
##  [13] "5A"       "5A"       "5A"       "5A"       "5A"       "5A"      
##  [19] "5A"       "5B"       "5A"       "5B"       "5B"       "5A"      
##  [25] "5A"       "5B"       "5B"       "5A"       "5B"       "5B"      
##  [31] "5A"       "5A"       "5A"       "4A"       "5A"       "5A"      
##  [37] "4A"       "4A"       "5A"       "5A"       "4A"       "5A"      
##  [43] "Teachers" "5A"       "4A"       "4A"       "4A"       "4A"      
##  [49] "4A"       "4A"       "4A"       "4A"       "4A"       "4A"      
##  [55] "4A"       "3B"       "3B"       "3B"       "3B"       "3B"      
##  [61] "3B"       "5B"       "3B"       "3B"       "3B"       "3B"      
##  [67] "3B"       "5B"       "3B"       "3B"       "5B"       "5B"      
##  [73] "3B"       "4B"       "2A"       "2A"       "2A"       "2A"      
##  [79] "2A"       "2A"       "2A"       "4A"       "2A"       "2A"      
##  [85] "4B"       "4B"       "5A"       "2A"       "2A"       "2A"      
##  [91] "2A"       "2A"       "Teachers" "Teachers" "1B"       "1B"      
##  [97] "1B"       "1B"       "1B"       "1B"       "Teachers" "1B"      
## [103] "1B"       "1B"       "1B"       "1B"       "1B"       "1B"      
## [109] "1B"       "3B"       "1B"       "1B"       "1B"       "1B"      
## [115] "1B"       "1B"       "3B"       "2B"       "2B"       "4A"      
## [121] "2B"       "3B"       "2B"       "Teachers" "2B"       "1A"      
## [127] "3B"       "2B"       "3A"       "2B"       "2B"       "3A"      
## [133] "3A"       "3A"       "3A"       "3B"       "4A"       "3B"      
## [139] "2B"       "3B"       "3A"       "3A"       "2B"       "3A"      
## [145] "2B"       "3B"       "Teachers" "Teachers" "3A"       "2B"      
## [151] "5B"       "5A"       "1A"       "Teachers" "1A"       "1A"      
## [157] "1A"       "1A"       "3A"       "1A"       "1B"       "1A"      
## [163] "1A"       "1A"       "1A"       "1A"       "1A"       "1A"      
## [169] "1A"       "1B"       "3A"       "3A"       "1A"       "1A"      
## [175] "1A"       "1A"       "1A"       "3A"       "1A"       "4A"      
## [181] "1A"       "1A"       "3A"       "3A"       "4B"       "4B"      
## [187] "4B"       "4B"       "3A"       "4A"       "4B"       "4B"      
## [193] "3A"       "4B"       "3A"       "Teachers" "4B"       "3A"      
## [199] "4B"       "4B"       "4A"       "3A"       "3A"       "4B"      
## [205] "2B"       "Teachers" "2B"       "2B"       "4B"       "2B"      
## [211] "3A"       "2B"       "2B"       "4B"       "4B"       "2B"      
## [217] "2B"       "4B"       "2B"       "4B"       "2B"       "4B"      
## [223] "2B"       "2B"       "4B"       "4B"       "2B"       "2B"      
## [229] "2A"       "2A"       "2A"       "1B"       "3A"       "4B"      
## [235] "2A"       "1B"       "2A"       "2A"       "2A"       "2A"      
## [241] "1B"       "2A"
# 检查邻接矩阵
Stucont[c(1:10),c(1:10)]
## 10 x 10 sparse Matrix of class "dgCMatrix"
##    [[ suppressing 10 column names '1426', '1427', '1428' ... ]]
##                                     
## 1426  .  27 45  75 19 43  8 12 23 27
## 1427 27   .  4 100  4 63 20  5 44 13
## 1428 45   4  .   9  4 16  2  4 19 14
## 1429 75 100  9   .  9 75 11  5 62 36
## 1430 19   4  4   9  . 15  4  7  4  3
## 1431 43  63 16  75 15  . 43 16 42 41
## 1434  8  20  2  11  4 43  .  3  8  8
## 1435 12   5  4   5  7 16  3  .  6 11
## 1437 23  44 19  62  4 42  8  6  . 29
## 1439 27  13 14  36  3 41  8 11 29  .

上述矩阵为10*10邻接矩阵，通过邻接矩阵也能够看出每个师生之间的接触频数，邻接矩阵关于对角线对称；举个例子，从上述矩阵能够看到(1428,1427)位置的数字为100，即1428与1427这两位师生在两天内接触了100次，也即在现实中这两位同学很可能是两个好朋友。

网络特征探索

整体网络特征指标

  1. 网络密度

网络密度是测量网络的指标，表示网络中节点联系的紧密程度。整体网络密度越大，对个体的影响越大，反映节点之间的关联越紧密，反之，则越松散。

# 网络密度
edge_density(Stucont)
## [1] 0.2852097

本文所研究的网络密度从上述代码中计算得出，约为0.2852。

  1. 网络密度

平均路径长度是另一个测量整体网络的指标，指网络中所有节点之间的平均最短距离，用来衡量可达性及传输性能与效率。

# 平均最短距离
mean_distance(Stucont)
## [1] 1.732451

从上述代码中算出网络的平均路径长度约为1.73，即平均接触网络中的任意1.7个师生就能够建立联系。

  1. 平均聚类系数（传递性）

最后一个探究整体网络的指标为平均聚类系数（又称传递性），即衡量网络节点（师生）间的紧密程度，平均聚类系数越大，则表明网络节点间的联系越紧密，网络节点间的潜在流动可能性就越大。

# 平均聚类系数（传递性）
transitivity(Stucont)
## [1] 0.4797899

从上述代码中算出网络的平均聚类系数约为0.4798。

综上对于网络整体的探索意义在于网络的密度、聚类系数、平均最短路径三个指标均能够衡量疾病在学校个体之间传播的难易程度，例如，从平均最短路径（1.73）能够看出，研究所实行的学校中的个体与整个网络建立联系只需要接触任意1.7个人，进一步能够看出疾病在学校的传播是非常容易的，而如果能够通过先进的仪器对接触进行跟踪，在疾病传播开始时，采取封班而非封校的政策有显著降低社会经济成本且有效阻碍疾病传播，那么将这种手段推广到校园的意义将会是很大的。另外，通过对网络的密度进行统一的衡量，对本文的措施在什么样的网络中能够使用具有很大的参考意义。

网络节点特征指标

  1. 点度中心度

点度中心度是通过与该节点有直接联系的节点数来测度，点度中心度越大的节点说明该阶段与网络中其他节点的练习更为紧密，在网络中居于更为中心的地位，相应的该节点在该网络中的影响力越大。

Stucont_deg <- degree(Stucont,
                      mode=c("All")) # 无向网络直接设置为all
V(Stucont)$degree <- Stucont_deg # 赋予节点点度中心度属性
head(V(Stucont)$degree)
## [1] 83 47 82 64 37 71
mean(Stucont_deg) # 查看网络平均点度中心度
## [1] 68.73554
median(Stucont_deg) # 中位数
## [1] 68.5
  1. 接近中心度

接近中心度指网络中一个节点与该网络其他所有节点的捷径距离之和，如果一个节点与网络中所有其他节点的“距离”都很短，则说明该节点具有较高的接近中心度，也可以理解为该节点在多大程度不受其他节点的控制。接近中心度越大，则该节点越处于网络中的边缘地位。

Stucont_eig <- evcent(Stucont)$vector
V(Stucont)$Eigen <- Stucont_eig
head(V(Stucont)$Eigen)
## [1] 0.04327147 0.02264431 0.03072487 0.03862008 0.00438218 0.03152824
mean(Stucont_eig) # 查看网络平均接近中心度
## [1] 0.1069947
median(Stucont_eig) # 中位数
## [1] 0.04628313
  1. 中介中心度

中介中心度指一个节点担任其他两个节点之间最短路径的次数，一个节点充当“中介”的次数越高，它的中介中心度就越大。

Stucont_bw <- betweenness(Stucont, directed = FALSE)
V(Stucont)$betweenness <- Stucont_bw
head(V(Stucont)$betweenness)
## [1] 55.57971 60.74399 61.88006 81.36161 21.08789 92.51743
mean(Stucont_bw) # 查看网络平均中介中心度
## [1] 126.2429
median(Stucont_bw) # 中位数
## [1] 104.1524
par(mfrow=c(2,2))
p1 <- hist(Stucont_deg, main = "Histogram of Degree Centrality", xlab = "Degree", ylab = "")
p2 <- hist(Stucont_eig, main = "Histogram of Eigenvector Centrality", xlab = "Degree", ylab = "")
p3 <- hist(Stucont_bw, main = "Histogram of Betweeness Centrality", xlab = "Degree", ylab = "")

通过对节点特征描述的不同指标，本文绘制了如上三张直方图；首先，从左上角的点度中心度的直方图中能够看出，网络结构中所有节点在整个网络中的重要性分布是比较平均的；其次，右上角的接近中心度直方图能够看出网络中节点的接近中心度主要分布在0.1左右，即由于学校规模并不是非常大，多数节点在网络中对其他节点的影响都是比较大的；最后，左下角的中介中心度直方图能够最直观的展现学校内学生的社交特征，即“交际花”占少数，更多的同学只与靠近自己的同学或老师有交流（这也导致下面可视化结果中，基于中介中心度的网络结构有更直观、更好看的图像）。

网络可视化

  1. 基于点度中心度的网络可视化
par(mfrow=c(1,1), mar=c(0,2,0,2))
set.seed(1001) # 设置种子
pal<-brewer.pal(length(unique(V(Stucont)$Class)), "Set3") # 根据节点的颜色来区别班级
plot(Stucont,edge.color = 'black',vertex.label.cex =0.5,
     vertex.color=pal[as.numeric(as.factor(vertex_attr(Stucont, "Class")))],
     vertex.size = sqrt(Stucont_deg)/3, edge.width=sqrt(E(Stucont)$weight/800), # 调整参数获得更好的可视化结果
     layout = layout.fruchterman.reingold) # 力导向网络结构图

从上述基于点度中心度的网络图中，能够看出每个班级的界限是比较明显的，并且每个班级中会有一个节点的颜色与其他节点不同，即每个班级的班主任。

  1. 基于接近中心度的网络可视化
par(mfrow=c(1,1), mar=c(0,2,0,2))
set.seed(1001)
plot(Stucont,edge.color = 'black',vertex.label.cex =0.5,
     vertex.color=pal[as.numeric(as.factor(vertex_attr(Stucont, "Class")))],
     vertex.size = sqrt(Stucont_eig)*10, edge.width=sqrt(E(Stucont)$weight/800), # 调整参数获得更好的可视化结果
     layout = layout.fruchterman.reingold) # 力导向网络结构图

基于接近中心度能够看出网络图的中心有几个比较大的节点，这些节点可以推测为是班级的“交际花”，而这些同学在整个校园网络的构成中也起到了重要的作用。

  1. 基于中介中心度的网络可视化
par(mfrow=c(1,1), mar=c(0,2,0,2))
set.seed(1001)
plot(Stucont,edge.color = 'black',vertex.label.cex =0.5,
     vertex.color=pal[as.numeric(as.factor(vertex_attr(Stucont, "Class")))],
     vertex.size = sqrt(Stucont_bw)/3, edge.width=sqrt(E(Stucont)$weight/800), # 调整参数获得更好的可视化结果
     layout = layout.fruchterman.reingold) # 力导向网络结构图

基于中介中心度的网络图像能够较明显的看出每个班级中的“交际花”，上图中能够看出每个班级中大致有一半擅长交际的同学以及另一部分不爱交际的同学，这个也是非常符合直觉的。

社区发现（基于Louvain算法）

Louvain算法可以将不同的节点划分到不同社区，每一个社区可以认为是一个类。本文采用Louvain算法进行社区发现及可视化。

# Louvain聚类（Louvain Clustering）
lc <- cluster_louvain(Stucont) # 根据算法建立聚类（Cluster）
communities(lc) # 查看节点所属聚类
## $`1`
##  [1] "1426" "1427" "1428" "1429" "1430" "1431" "1434" "1435" "1437" "1439"
## [11] "1441" "1443" "1451" "1452" "1453" "1457" "1458" "1459" "1461" "1465"
## [21] "1468" "1471" "1475" "1477" "1479" "1480" "1482" "1483" "1486" "1489"
## [31] "1493" "1495" "1498" "1501" "1502" "1511" "1516" "1520" "1522" "1563"
## [41] "1578" "1585" "1592" "1637" "1668" "1750" "1751" "1824" "1885"
## 
## $`2`
##  [1] "1500" "1503" "1504" "1519" "1521" "1524" "1525" "1528" "1532" "1533"
## [11] "1538" "1539" "1545" "1546" "1548" "1549" "1601" "1618" "1630" "1632"
## [21] "1653" "1705" "1730" "1797" "1802" "1803" "1805" "1807" "1815" "1818"
## [31] "1819" "1821" "1831" "1835" "1836" "1837" "1847" "1857" "1865" "1866"
## [41] "1880" "1888" "1892" "1895" "1910"
## 
## $`3`
##  [1] "1551" "1552" "1555" "1558" "1560" "1562" "1564" "1567" "1570" "1572"
## [11] "1574" "1579" "1580" "1594" "1685" "1700" "1707" "1709" "1712" "1714"
## [21] "1719" "1720" "1722" "1723" "1727" "1731" "1735" "1737" "1738" "1741"
## [31] "1744" "1746" "1748" "1763" "1780" "1782" "1795" "1800" "1801" "1809"
## [41] "1820" "1822" "1833" "1838" "1843" "1859" "1909"
## 
## $`4`
##  [1] "1603" "1604" "1606" "1609" "1613" "1616" "1617" "1625" "1628" "1641"
## [11] "1643" "1647" "1648" "1649" "1650" "1702" "1704" "1706" "1708" "1710"
## [21] "1713" "1715" "1718" "1732" "1739" "1743" "1749" "1851" "1852" "1854"
## [31] "1855" "1858" "1861" "1863" "1872" "1877" "1883" "1887" "1889" "1890"
## [41] "1897" "1898" "1902" "1906" "1907" "1911" "1913" "1916" "1917" "1919"
## [51] "1922"
## 
## $`5`
##  [1] "1656" "1661" "1663" "1664" "1665" "1666" "1670" "1673" "1674" "1675"
## [11] "1680" "1681" "1682" "1684" "1687" "1688" "1695" "1696" "1697" "1698"
## [21] "1745" "1765" "1779" "1908" "1912" "1920"
## 
## $`6`
##  [1] "1711" "1752" "1753" "1757" "1759" "1760" "1761" "1764" "1766" "1767"
## [11] "1768" "1770" "1772" "1774" "1775" "1778" "1783" "1787" "1789" "1790"
## [21] "1792" "1796" "1798" "1799"

通过观察上述代码运行结果，能够看出聚类数量以及每个聚类中的节点都有哪些。

par(mfrow=c(1,1), mar=c(0,2,0,2))
set.seed(1001)
plot(lc, Stucont, edge.color = 'black',vertex.label.cex =0.5,
     vertex.color=pal[as.numeric(as.factor(vertex_attr(Stucont, "Class")))],
     vertex.size = sqrt(Stucont_bw)/3, edge.width=sqrt(E(Stucont)$weight/800),
     layout = layout.fruchterman.reingold)

上图是网络图的社区发现可视化结果，虽然整所学校总共有十个班，然而上图中的聚类数量总共有6个，这个结果是比较反直觉的，其中的一个原因可能是虽然每个班级分成了两个班级，然而两个班级作为同一年级，故两个班之间的接触可能相对其他年级的同学更加频繁（同龄朋友在A班，自己在B班）。

研究SEIR模型与疾病传播模拟结果

研究通过对法国小学的疾病传播通过SEIR模型，结合三种不同策略（封校、封年级、封班）对学校内疾病传播的以及各种策略的效果进行了模拟，得到了如下结果：

上述两张图出自原文，纵轴为感染疾病的人数，横轴为时间；左图描述了疾病出现后封班策略实行的模拟结果，不同颜色的曲线代表不同长度的封校时间，例如24h即为封班一天，也就是说特定班级的学生一天不用上学；右图为封年级（一个年级有两个班）策略的疾病传播模拟结果。通过观察能够看出，随着封校时间的增长，感染人数的数量也会减少，然而边际减少的人数数量是递减的，即时间的增长在刚开始可能会显著降低感染人数，然而随着时间增长，降低感染人数的效果会减少；还能看出的一点是，随着封班、封年级的时间增长，整个学校受到疾病影响的持续时间也会减少；进一步观察能够看出，封班、封年级的时间超过72小时之后不会对感染人数有明显的降低效果，时间超过120小时之后，人数受到疾病影响的时间也会降低至30天持平。

上图是对各个策略封校、封年级、封班144小时的效果对比，从上图能够看出虽然封班、封年级的策略会减少人们受到疾病影响的时间，然而受到感染的人群能够降低至与封校同样的结果，即三种策略都能控制在感染人数为10左右

研究进一步对师生所住社区的疾病传播影响进行了模拟，上图为当社区疾病传播较严重的时候（即师生在社区暴露时间较长，有更高的概率受到感染），封校的政策虽然能够在短时间内降低受感染的人数，但是同时由于封校期间全校所有师生都暴露在了更高的风险下面，故可能会导致如上图封校策略曲线中的第二个高峰。

结论及讨论

综上，研究得出了封年级能够成为既能够有效降低疾病传播并且社会经济成本相对低的策略的结论，在外部社会疾病传播较严重时更是如此。而上述本文也用社区发现可视化的结果发现了封年级策略可能会是非常有效的策略，首先，年级之间的界限比较明显，其次是同年级班级之间的界限比较模糊，这两点原因使得疾病出现时，更多的影响会是在同年级，而不是在整个学校都会传播开。

而在当今新冠疫情长期肆虐的背景下，学生如何正常上课、社会如何正常运行提供了重要的政策启示。

par(mfrow=c(1,1), mar=c(0,2,0,2))
set.seed(1001)
plot(lc, Stucont, edge.color = 'black',vertex.label.cex =0.5,
     vertex.color=pal[as.numeric(as.factor(vertex_attr(Stucont, "Class")))],
     vertex.size = sqrt(Stucont_bw)/3, edge.width=sqrt(E(Stucont)$weight/800),
     layout = layout.fruchterman.reingold)